Developer CD Series 1992 June: ROMin Holiday/ADC Developer CD (1992-06) (''ROMin Holiday'')_iso/Developer Connection - 06-1992.iso/Tools & Apps/OS⁄Toolbox/MDEF (LS Pascal)/Utilities Unit

Text File | 1990-04-07 | 14.4 KB | 544 lines | [TEXT/PJMM]

{ ********************************************************** }
{                                                            }
{  Loose translation of ZoomRects() from an early release    }
{    of the Apple Software Supplement.                       }
{                                                            }
{ ********************************************************** }

unit utilities;

interface

    const
        ZOOMSTEPS = 16;
        ONE = 65536;
        CurDirStorePtr = $0398;

    var
        fract: Fixed;
        CurDirStore: ^longint;

    function HFSRunning: boolean;
    function NewRoms: boolean;
    function blend (i1, i2: integer): integer;
    procedure zoomrect (smallrect, bigrect: Rect; zoomup: boolean);
    procedure ltog (var r: Rect);
    procedure zoomport (wind: WindowPtr; up: Boolean);
    procedure centerwindow (wind: WindowPtr; r: Rect);
    procedure centerrect (var r1: Rect; r2: Rect);
    function TrackMyRect (aPoint: Point; r1: Rect; rad1, rad2: integer): Boolean;
    procedure DoAdjust (var r: Rect);
    procedure DoShowDialog (Dptr: DialogPtr);
    procedure get_resource_error (rtype: Str255; id: integer);
    procedure show_io_err (err: OSErr);


implementation

    function HFSRunning;

        const
            FSFCBLen = $3F6;

        var
            HFS: ^integer;

    begin
        HFS := pointer(FSFCBLen);
        HFSRunning := (HFS^ > 0);
    end;

    function NewRoms;

        const
            NewRomsID = 117;

        var
            RomVersion, Machine: integer;

    begin
        Environs(RomVersion, Machine);
        NewRoms := RomVersion >= NewRomsID;
    end;

    function blend;

        var
            smallFix, bigFix, tempFix: Fixed;

    begin
        smallFix := ONE * i1;
        bigFix := ONE * i2;
        tempFix := FixMul(fract, bigFix) + FixMul(ONE - fract, smallFix);
        blend := FixRound(tempFix);
    end;

    procedure zoomrect;

        var
            factor: Fixed;
            rect1, rect2, rect3, rect4: Rect;
            savePort, deskPort: GrafPtr;
            i: integer;

    begin
        GetPort(savePort);
        deskPort := GrafPtr(NewPtr(sizeof(GrafPort)));
        OpenPort(deskPort);
        InitPort(deskPort);
        SetPort(deskPort);
        PenPat(gray);
        PenMode(notPatXor);
        if zoomup then
            begin
                rect1 := smallrect;
                factor := FixRatio(6, 5);
                fract := FixRatio(541, 10000);
            end
        else
            begin
                rect1 := bigrect;
                factor := FixRatio(5, 6);
                fract := ONE;
            end;
        rect2 := rect1;
        rect3 := rect1;
        FrameRect(rect1);
        for i := 1 to ZOOMSTEPS do
            begin
                rect4.left := blend(smallrect.left, bigrect.left);
                rect4.right := blend(smallrect.right, bigrect.right);
                rect4.top := blend(smallrect.top, bigrect.top);
                rect4.bottom := blend(smallrect.bottom, bigrect.bottom);
                FrameRect(rect4);
                FrameRect(rect1);
                rect1 := rect2;
                rect2 := rect3;
                rect3 := rect4;
                fract := FixMul(fract, factor);
            end;
        FrameRect(rect1);
        FrameRect(rect2);
        FrameRect(rect3);
        ClosePort(deskPort);
        DisposPtr(Ptr(deskPort));
        PenNormal;
        SetPort(savePort);
    end;

{ ********************************************************** }
{                                                            }
{       procedure ltog(r : Rect);                            }
{                                                            }
{  Converts the Rect referenced by r from local to global    }
{  coordinate system.                                        }
{                                                            }
{ ********************************************************** }


    procedure ltog;

        var
            p1, p2: Point;

    begin
        p1 := r.topLeft;
        p2 := r.botRight;
        LocalToGlobal(p1);
        LocalToGlobal(p2);
        Pt2Rect(p1, p2, r);
    end;

{ ********************************************************** }
{                                                            }
{     procedure zoomport(wind:WindowPtr;up:Boolean);         }
{                                                            }
{   Zooms the window referenced by "wind" either from an     }
{   inivisible state to a visible state, or vice versa. Pass }
{   TRUE in the "up" Boolean parameter to zoom a window to   }
{   open, an FALSE to zoom it close.  The WindowPtr must     }
{   have already been created elsewhere, and zooming the     }
{   window invisible only hides the window, it does not      }
{   destroy the WindowPtr data.                              }
{                                                            }
{ ********************************************************** }

    procedure zoomport;

        var
            r1, r2, r3: Rect;

    begin
        SetPort(wind);
        SetRect(r1, 0, 20, 0, 20);
        r3 := wind^.portRect;
        r2 := r3;
        InsetRect(r2, (r3.right - r3.left + 20) div 2, (r3.bottom - r3.top + 20) div 2);

        ltog(r2);
        ltog(r3);

        if up then
            begin
                zoomrect(r1, r2, TRUE);
                zoomrect(r2, r3, TRUE);
                ShowWindow(wind);
                SetPort(wind);
            end
        else
            begin
                HideWindow(wind);
                zoomrect(r2, r3, FALSE);
                zoomrect(r1, r2, FALSE);
            end;
    end;

{********************************************************************}
{                                                                    }
{     procedure centerwindow(wind:WindowPtr;r:Rect);                 }
{                                                                    }
{   centers the window referenced by the WindowPtr: wind within      }
{   the Rect referenced by the Rect* r.  To center a window in       }
{   the Macintosh screen, (or primary screen if using a Mac II),     }
{   call...                                                          }
{                                                                    }
{     centerwindow(theWindow,&screenBits.bounds);                    }
{                                                                    }
{********************************************************************}

    procedure centerwindow;

        var
            r2: Rect;
            windW, windH: integer;
            rectW, rectH: integer;
            newW, newH: integer;

    begin
        r2 := wind^.portRect;
        windW := r2.right - r2.left;
        windH := r2.bottom - r2.top;
        rectW := r.right - r.left;
        rectH := r.bottom - r.top;
        newW := r.left + (rectW - windW) div 2;
        newH := r.top + (rectH - windH) div 2;
        MoveWindow(wind, newW, newH, FALSE);
    end;

{********************************************************************}
{                                                                    }
{        procedure centerrect(r1,r2:Rect);                           }
{                                                                    }
{   centers the rectangle referenced by the Rect* r1 within          }
{   the Rect referenced by the Rect* r2.  To center the Rect         }
{   innerRect within the Rect outerRect, call...                     }
{                                                                    }
{        centerrect(&innerRect,&outerRect);                          }
{                                                                    }
{********************************************************************}

    procedure centerrect;

    begin
        OffsetRect(r1, ((r2.right - r2.left) - (r1.right - r1.left)) div 2 - r1.left, ((r2.bottom - r2.top) - (r1.bottom - r1.top)) div 2 - r1.top);
    end;


{********************************************************************}
{                                                                    }
{ Function TrackMyRect(aPoint:Point;r1:Rect;rad1,rad2:integer):Boolean; }
{                                                                    }
{   TrackMyRect() treats the Rect referenced by *r1 much like        }
{   the TrackControl(ControlHandle) of the Control Manager. The      }
{   point passed by aPoint should be the local coordinates of the    }
{   mouse down location in the window in which the Rect resides,     }
{   and should initially be called with the mouse location inside    }
{   of the Rect.                                                     }
{                                                                    }
{   rad1 and rad2 are radii for rounded rects, pass 0 in these       }
{   values if the Rect is not rounded.                               }
{                                                                    }
{   Sample Code Fragment....                                         }
{                                                                    }
{   thePoint     : Point;                                            }
{   myRect       : Rect;                                             }
{   rectSelected : Boolean;                                          }
{                                                                    }
{   thePoint := theEvent.where;                                      }
{   GlobalToLocal(&thePoint);                                        }
{   if (PtInRect(thePoint,&myRect))                                  }
{       rectSelected := TrackMyRect(thePoint,&myRect,0,0);           }
{                                                                    }
{********************************************************************}

    function TrackMyRect;

        var
            returnVal: boolean;

    begin
        returnVal := TRUE;
        InvertRoundRect(r1, rad1, rad2);
        repeat
            begin
                GetMouse(aPoint);
                if (PtInRect(aPoint, r1) <> returnVal) then
                    begin
                        returnVal := not returnVal;
                        InvertRoundRect(r1, rad1, rad2);
                        SystemTask;
                    end;
            end;
        until StillDown;
        GetMouse(aPoint);
        TrackMyRect := PtInRect(aPoint, r1);
    end;

    procedure DoAdjust;

        var
            x, y, xd, yd: LongInt;

    begin
        if not ((screenBits.bounds.right = 512) and (screenBits.bounds.bottom = 342)) then
            begin
                xd := (r.left - r.right) div 2;
                yd := (r.bottom - r.top) div 2;
                x := (((r.right + xd) * screenBits.bounds.right) div 512) - xd - r.right;
                y := (((r.top + yd) * screenBits.bounds.bottom) div 342) - yd - r.top;
                OffsetRect(r, x, y);
            end;
    end;

    procedure DoShowDialog;

        var
            r1, r2, r: Rect;

    begin
        r1 := Dptr^.portBits.bounds;
        r2 := Dptr^.portRect;
        r.top := -1 * r1.top;    {-1.r1.top }
        r.left := -1 * r1.left;
        r.right := (r2.right - r2.left) + r.left;
        r.bottom := (r2.bottom - r2.top) + r.top;
        DoAdjust(r);
        MoveWindow(Dptr, r.left, r.top, True);
        ShowWindow(Dptr);
    end;

    procedure get_resource_error;

        const
            p0 = 'The program had trouble loading a resource, the resource is:';       {static text}

        var
            myDialog: DialogPtr;
            myDialogPeek: DialogPeek;
            dStorage: DialogRecord;
            itemNumber: integer;
            itemType: integer;
            itemList, itemHandle: Handle;
            dispRect, dRect: Rect;
            theString: str255;
            HMT, zMessage, zAddress: str255;

        procedure DefineDialog (var myDialog: DialogPtr;        {create Dialog in memory}
                                        var dStorage: DialogRecord);

            const
                statTextLength = 2;
                statTextNu = 2;

            type        {these are for creating the Dialog Template in memory}
                TextT = packed array[1..statTextLength] of char;
                StatTextTitleT = array[1..statTextNu] of string[statTextLength];
                StatTextRectT = array[1..statTextNu] of Rect;
                ButtonsType = record
                        CtlHndl: Handle;
                        Itemrect: Rect;
                        ItemType, ItemLen: SignedByte;
                        zTitle: packed array[1..4] of char;
                    end;
                StatTextsType = array[1..statTextNu] of record
                        statTextHndl: Handle;
                        Itemrect: Rect;
                        ItemType, ItemLen: SignedByte;
                        zText: TextT;
                    end;
                ItemListT = record
                        ItemCountM1: integer;
                        myButtons: ButtonsType;
                        myStatTexts: StatTextsType;
                    end;
                ItemListTPtr = ^ItemListT;
                ItemListTHdl = ^ItemListTPtr;

            var
                DITLHdl: ItemListTHdl;
                frameRect: Rect;
                zSTTitle: StatTextTitleT;
                zSTRect: StatTextRectT;
                j: integer;

        begin
            SetRect(zSTRect[1], 10, 5, 300, 40);
            SetRect(zSTRect[2], 10, 60, 300, 110);
            DITLHdl := ItemListTHdl(NewHandle(SizeOf(ItemListT)));      {create the DialogTemplate}
            HLock(handle(DITLHdl));
            with DITLHdl^^ do
                begin
                    ItemCountM1 := 1 + statTextNu - 1;
                    with myButtons do
                        begin
                            CtlHndl := nil;
                            SetRect(Itemrect, 210, 100, 300, 118);
                            frameRect := Itemrect;
                            ItemType := CtrlItem + BtnCtrl;
                            ItemLen := 4;
                            zTitle := ' OK ';
                        end;
                    for j := 1 to statTextNu do
                        with myStatTexts[j] do
                            begin
                                statTextHndl := nil;
                                Itemrect := zSTRect[j];
                                ItemType := statText;
                                ItemLen := statTextLength;
                                NumToString(j - 1, theString);
                                zText[1] := '^';
                                zText[2] := theString[1];
                            end;
                end;
            HUnLock(handle(DITLHdl));
            itemList := Handle(DITLHdl);
        end;

    begin
        DefineDialog(myDialog, dStorage);
        FlushEvents(everyEvent, 0);
        InitCursor;
        SetRect(dRect, 0, 0, 310, 125);
        centerrect(dRect, screenBits.bounds);
        NumToString(id, theString);
        zAddress := Concat('Type: ', rtype, '    Number: ', theString);
        ParamText(p0, zAddress, '', '');
        myDialog := NewDialog(@dStorage, dRect, '', TRUE, DBoxProc, WindowPtr(-1), FALSE, 0, itemList);
        repeat
            ModalDialog(nil, itemNumber);
        until itemNumber = OK;
        myDialogPeek := DialogPeek(myDialog);
        CloseDialog(myDialog);
        DisposHandle(myDialogPeek^.items);
    end;

    procedure show_io_err;

        const
            err_alert_id = 256;
            io_err_string_id = 257;
            fsDSIntErr = -127;

        var
            err_string: Str255;
            offset, alert_result: integer;

    begin
        case err of
            badMDBErr:
                offset := 1;
            badMovErr:
                offset := 2;
            bdNamErr:
                offset := 3;
            dirFulErr:
                offset := 4;
            dirNFErr:
                offset := 5;
            dskFulErr:
                offset := 6;
            dupFNErr:
                offset := 7;
            eofErr:
                offset := 8;
            extFSErr:
                offset := 9;
            fBsyErr:
                offset := 10;
            fLckdErr:
                offset := 11;
            fnfErr:
                offset := 12;
            fnOpnErr:
                offset := 13;
            fsDSIntErr:
                offset := 14;
            fsRnErr:
                offset := 15;
            gfpErr:
                offset := 16;
            ioErr:
                offset := 17;
            memFullErr:
                offset := 18;
            noMacDskErr:
                offset := 19;
            nsDrvErr:
                offset := 20;
            nsvErr:
                offset := 21;
            opWrErr:
                offset := 22;
            paramErr:
                offset := 23;
            permErr:
                offset := 24;
            posErr:
                offset := 25;
            rfNumErr:
                offset := 26;
            tmfoErr:
                offset := 27;
            tmwdoErr:
                offset := 28;
            volOffLinErr:
                offset := 29;
            volOnLinErr:
                offset := 30;
            vLckdErr:
                offset := 31;
            wrgVolTypErr:
                offset := 32;
            wrPermErr:
                offset := 33;
            wPrErr:
                offset := 34;

            resNotFound:
                offset := 35;
            resFNotFound:
                offset := 36;
            addResFailed:
                offset := 37;
            rmvResFailed:
                offset := 38;
            resAttrErr:
                offset := 39;
            mapReadErr:
                offset := 40;

            otherwise
                ;
        end;
        GetIndString(err_string, io_err_string_id, offset);
        if err_string = '' then
            begin
                get_resource_error('STR#', io_err_string_id);
                ExitToShell;
            end;
        ParamText(err_string, '', '', '');
        alert_result := Alert(err_alert_id, nil);
        ExitToShell;
    end;

end.